perm filename CLEFS.F4[NEW,LCS]10 blob sn#356846 filedate 1978-05-26 generic text, type T, neo UTF8
C**** CLEFS, MOVER ********* 

	SUBROUTINE CLEFS
	DIMENSION KPNT1(11),JCLEF(1750),RCMIN(4),KPNT2(11),KCLEF(350)
	1,CM(4),LCLEF(350),KPNT3(11),MCLEF(350),NCLEF(350)
	1,KPNT4(11),KPNT5(11)
	COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /MIN/MINI,RMINI
      DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/,XDIS/1.0/
	EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,KPNT2
	1(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5)),(J8,JQ(6))
	1,(DEG,R9,RJQ(7)),(NJR,RJQ(8)),(KJ,KPNT1(11)),(KCLEF,JCLEF(351))
	1,(R3,RJQ(1)),(LCLEF,JCLEF(701)),(KL,KPNT3(11)),(KM,KPNT4(11))
	1,(MCLEF,JCLEF(1051)),(NCLEF,JCLEF(1401)),(KN,KPNT5(11))
CX	J5=MOD(J5,100)
CX	IF(J5)J5=-J5
	IF(R6.GE.100)R6=R6-100
C SOMETIMES MAKE SIZE +100 FOR PARTS PROGRAM.
	CALL NOZERO(R6)
	IF(R7.EQ.0)R7=R6
C  IF P7 = 0, IT WILL EQUAL P6.
	IF(JA.GT.10)GO TO 9
	NAME='CLEFA'
	IF(J5.LT.20)GO TO 4
	R6=R6*.3
C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
	R7=R7*.3
	GO TO 4
9	IF(NAME.EQ.NJR)GO TO 4
	IF(NAME.EQ.0)GO TO 177
	IF(NJR.EQ.0)GO TO 4
177	IF(NJR.EQ.0)GO TO 8	
C  TO PICK UP BASIC DRAW NAME FROM P10 
	NAME=NJR
	GO TO 4
8	CALL TYPSTR('SET P10=1')
	CALL TYPCRLF
CCC8	TYPE 5
CCC5	FORMAT(' SET P10=1'/)
C  LEADS TO PROPER FILE CALL
4	JTAIL=-1
	IF(JA.NE.3)GO TO 44
	IF(R5.NE.0.8)GO TO 44
	JTAIL=0
C R5=0.8 FOR TREBLE CLEF WITH 8 ON TAIL. (FOR TENOR VOCAL)
44	NM=NAME+2*(J5/10)
C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
	JEZ=MOD(J5,10)+1
2	IF(NM.EQ.NM1)GO TO 30
	IF(NM.EQ.NM2)GO TO 30
	IF(NM.EQ.NM3)GO TO 30
	IF(NM.EQ.NM4)GO TO 30
	IF(NM.EQ.NM5)GO TO 30
C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
C  JUMP IF ALREADY IN CORE
	NPP=0
	IF(JA.NE.11)GO TO 1111
C  DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
	NPP=-1
	IF(LOOKF(NM))GO TO 1111
CCC	TYPE 1112,NM
	CALL TYPWRD(NM)
	CALL TYPSTR(' -- NOT FOUND')
1112	CALL TYPCRLF
	RETURN
CCC1112	FORMAT(1XA5,' -- NOT FOUND')
1111	CALL GETFI2(NM,NPP)
	IF(NPP.LE.0)GO TO 1113
CCC	TYPE 1114,NM
	CALL TYPWRD(NM)
	CALL TYPSTR('.DMD  NOT FOUND*****')
	GO TO 1112
CCC1114	FORMAT(1XA5,'.DMD  NOT FOUND*****')
1113	GO TO(33,233,333,433),KX
C  GOES TO 133 WHEN KX IS 0
133	KX=1
	NM1=NM
	CALL FASTI2(KPNT1,11)
	CALL FASTI2(JCLEF,KJ)
C  NEW DATA READER  6/74 -- 5/75  HOLDS 5 .DMD FILES IF THEY FIT.
	IF(KJ.LE.350)GO TO 30
	KX=0
	NM2=0
	GO TO 30
33	CALL FASTI2(KPNT2,11)
	KX=0
	IF(KK.GT.350)GO TO 1111
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(KCLEF,KK)
	NM2=NM
	KX=2
	GO TO 30
233	CALL FASTI2(KPNT3,11)
	KX=0
	IF(KL.GT.350)GO TO 1111
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(LCLEF,KL)
	KX=3
	NM3=NM
C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
C  R6 IS SIZE FACTOR
	GO TO 30
333	CALL FASTI2(KPNT4,11)
	KX=0
	IF(KM.GT.350)GO TO 1111
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(MCLEF,KM)
	KX=4
	NM4=NM
	GO TO 30
433	CALL FASTI2(KPNT5,11)
	KX=0
	IF(KN.GT.350)GO TO 1111
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(NCLEF,KN)
	NM5=NM
30	IF(J5.GT.3)GO TO 811
	IF(JA.NE.3)GO TO 811
C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
C  ↑↑↑↑↑↑↑↑  FIXUP SOMEDAY IN .DMD FILES
	IF(IABS(J4).LT.80)GO TO 812
	RSTJ2=.8*RSTJ2
C  TO SET HGT. OF MINI CLEFS
	R4=R4+CM(JEZ)
C  SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
812	IF(JEZ.NE.4)GO TO 811
	R4=R4+2
	JEZ=3
C   ABOVE IS NOW AT TOP

811	A=R4
	R4=A+2.9
C  ADJUSTS HEIGHT(??)
	CALL CENTX
	R4=A

	IF(NM.NE.NM1)GO TO 816
	L=KPNT1(JEZ)
	IF(L.LE.0)GO TO 817
	GO TO 113
816	IF(NM.NE.NM2)GO TO 813
	L=KPNT2(JEZ)
	IF(L.LE.0)GO TO 817
	L=L+350
	GO TO 113
813	IF(NM.NE.NM3)GO TO 814
	L=KPNT3(JEZ)
	IF(L.LE.0)GO TO 817
	L=L+700
	GO TO 113
814	IF(NM.NE.NM4)GO TO 815
	L=KPNT4(JEZ)
	IF(L.LE.0)GO TO 817
	L=L+1050
	GO TO 113
CCC817	TYPE 818,J5
817	CALL TYPINT(J5)
	CALL TYPSTR(' NOT FOUND *******')
	CALL TYPCRLF
	GO TO 334
CCC818	FORMAT(I4,' NOT FOUND *******')
CC 	IF(NM.NE.NM5)
815	L=KPNT5(JEZ)
	IF(L.LE.0)GO TO 817
C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)
	L=L+1400
113	IF(J9.EQ.0)GO TO 31
C***** ROTATE *******
	R7=R7*RSTJ2
	R6=R6*RSTJ2
	N=JCLEF(L)
	KNT=701
C ROTATED DATA IS PUT STARTING AT LOCATION 701.(AREA FOR NM3)******
	JCLEF(KNT)=N
	DO 1 K=L+1,N+L-1
	CALL UNPACK(J,M,JCLEF(K))
	X=J*R6
	Y=M*R7
	JJ=JCLEF(K)/100000000
	AX=ATAN2(X,Y)*57.29578
	HYP=SQRT(X**2+Y**2)
	ROT=DEG+AX
	J=ROFF(HYP*COSD(ROT))
	M=ROFF(HYP*SIND(ROT))
	KNT=KNT+1
	IF(J)J=1000-J
	IF(M)M=1000-M
1	JCLEF(KNT)=M*10000+J+JJ*100000000
	L=701
C  ***********  SEE AT TOP **********
	R6=1.
	R7=1.
	RSTJ2=1.
C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
CC	CALL ROTATE(JCLEF,L)
	NM3=0
C  WIPES OUT DATA AREA FOR NM3
C  R9=P9=DEGREES OF ROTATION (0-360)
	IF(KK.GT.350)KX=0
C CHECK TO SEE IF DATA WAS WIPED OUT.
31	A=-1
C  FLAG FOR THICKNESS OR NO.
	IF(J8.EQ.-2)GO TO 32
	IF(R8.LE.0)GO TO 34
	A=0
	CALL THICK
C THICK RETURNS NUMBER OF THICKNESSES IN J8 AND "SCALED" STEP IN R8
C NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
CC	J9=J8/100
CC	J4=-1
C FLAG FOR SINGLE ADDED VERTICAL THICKNESS, NO MATTER WHAT SIZE. R8=.5
CC	R8=AMOD(R8,100.0)
CC	J8=R8
CC	IF(R8.NE.J8)J4=0
CC	R9=RSTJ2*DIS
C  R8 AND R9 ARE FACTORS TO CAUSE RIGHT NUM OF LINES FOR THICKNESS.
CC	J8=J8*R9
CC	J9=J9*R9
CC	IF(J9.NE.0.AND.J8.NE.0)J9=J8
C  IF BOTH X AND Y THICKNESS IS USED THEY WILL BECOME EQUAL!
CC	R8=1/DIS
CC	IF(J4)GO TO 32
CC	J9=1
C SINGLE ADDED THICKNESS, NO MATTER WHAT SIZE.
CC	R8=1
	GO TO 32
34	IF(IPLT)GO TO 77
	IF(J8.NE.-1)GO TO 32
C			J8=-2 OMITS FILLER DURING PLOT
77	DO 3 K=L+1,JCLEF(L)+L
	IF(JCLEF(K).LT.200000000)GO TO 3
	JEZ=JCLEF(L)-1
	IF(K.GT.L+1)JEZ=JEZ-K+L+1
	CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
	GO TO 32
3	CONTINUE
C  FILLS ONLY WHEN PLOTING OR R8=-1
32	CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
	IF(A)GO TO 334
	IF(J8.NE.0)GO TO 234
	IF(J9.EQ.0)GO TO 334
	GO TO 134
234	J8=J8-1
	R3=R3+XDIS
C XDIS = 1 PLOTTER STEP
134	IF(J9.EQ.0)GO TO 32
	J9=J9-1
	CENTR=CENTR+XDIS
	GO TO 32
334	IF(JTAIL)RETURN
	JTAIL=-1
	JA=10
	JEZ=9
C  JEZ=9 MAKES AN 8 APPEAR UNDER TAIL OF TREBLE CLEF.
	R6=.2
	R7=R6
	NM='BDR40'
	R3=R3+14*RSTJ2
	R4=-4
	GO TO 2
	END


	SUBROUTINE MOVER
	IMPLICIT INTEGER(A-Q,S-Z)
	DIMENSION IR(2,250)
	REAL POS,EXTEN,PRCNT,ACCX
	COMMON/RINP/R(2,250),NO(350),NP(250)  /MKX/KSLA,ISEMI,LESS,IGT
C ARRAY NO(X) USED IN 'MOVIT'.  HOLDS ALL POINTS TO BE MOVED AT ANY TIME.
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/STF/RSTFAC(0/7),RSTJ2
	1 /A2Z/LAA,LBB,LCC,A1(6),LJJ,LKK,LEL
	COMMON/XRN/RN(1) /KJY/ KY,JY  /JSTFY/ROV,PRCNT,RJSZ /IDEV/IDEV
	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
	1 /POSI/STFF(0/7),JJ2,POS /LIMIT/LIMIT,ITEM,LL,I,IX/PTR/PWDS(1)
	1 /ALF/INP(46),ACCX,ML,RRT,RZRO,NCNT,JSZ,OV,RSPC,KN,RA,RB,
	1 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,RV,RQ6
      EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
	1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(R11,RJQ(9))
	1,(IR,R)
	DATA F78F/'(78F)'/,FA1/'(A1 )'/,FA5/'(A5 )'/
CC	DATA F78F/'(78F)'/,FA1/'(A1 )'/,FA5/'(A5 )'/,RSP/.5/,RI/4.5/

	JJ2=999
	J2=0
	ASK=-1
C  99=BACKUP
6	CALL VLINE(R2,R4,R5,R6)
	IF(R2.GE.99)RETURN
	IF(INP(1).EQ.LJJ)GO TO 12
CCC167	TYPE 5
167	CALL TYPSTR('TYPE NEW STAFF #, POS1, POS2, UP-DOWN # ')
CCC5	FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN #  '$)
	READ(IDEV,F78F,END=267)R7,R8,R9,R11
CQQ	ACCEPT F78F,R7,R8,R9,R11
	IF(R7.GE.99)GO TO 6
	IF(R2.LE.7.AND.R7.GT.7)GO TO 167
C  TRY AGAIN IF CONFUSION.
	RDIS=0
	REREAD FA1,L
C FOR LPEN TYPE 'L'. BUT 4TH # MUST APPEAR WHEN NEEDED.
	IF(L.EQ.LESS)GO TO 267
C < RETURN TO TTY MODE
	IF(L.NE.IGT)GO TO 367
	IDEV=1
	GO TO 167
367	IF(L.EQ.LBB)GO TO 6
	IF(R2.GT.7)R7=R2
	IF(R7.EQ.R2)GO TO 1201
	CALL TYPSTR('MOVED TO STAFF ')
	CALL TYPFLT(R7)
	CALL TYPCRLF
CCC	IF(R7.NE.R2)TYPE 1200,R7
1201	IF(L.NE.LEL)GO TO 66
	DO 67 K=1,2
	R8=RY
	CALL LPEN(R7,RY,RX)
67	IF(R7.GE.99)GO TO 6
	R9=RY
CC66	JJ2=1
66	NST=1
C  FOR START OF LOOP (1 UNLESS USING COPYIT)
	IF(INP(1).NE.LCC)GO TO 68
	NST=ITEM+1
	CALL COPYIT
68	IF(R11.NE.0)CALL UPDN(NST)
	JJ=0 
	IF(R4.NE.R8.OR.R5.NE.R9)JJ=-1
	JY=0
C  JY IS CHANGED IN GETPTS
	IF(JJ)CALL GETPTS(NST)
	IF(R2.NE.R7)CALL STFCH
	IF(JY.NE.0)GO TO 1
7	IF(JJ2.EQ.999)JJ2=-1
	RETURN
CC	IF(JY.EQ.0)RETURN
1	CALL MOVIT(RN,NO,R4,R5,R8,R9)
	RETURN
267	IDEV=5
	GO TO 167
12	IF(R4.EQ.0)R4=.001
	IF(R5.EQ.0)R5=200
	NCNT=0
	RRT=R5
	RZRO=R4
	RJSZ=4.5
CC	RJSZ=RI
	CALL GETPTS(1)
	IF(JY.EQ.0)GO TO 7
C RETURN IF NO ITEMS FOUND TO DEAL WITH.
	ROV=RRT
	PRCNT=1.
CC	R7=R2
	R6=0
	R11=0
19	IF(NCNT.GT.9)GO TO 101
	RJSZ=RJSZ-.06
	RP=PRCNT
	NCNT=NCNT+1
C  TEMPORARY COUNTER
	CALL TYPINT(NCNT)
	CALL TYPCHR('  ',2)
CCC	TYPE F78F,RCNT
	CALL JUSTFY(7,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)

110	IF(ROV.LE.RRT+.01)GO TO 2
	IF(RJSZ.GT.4)RJSZ=4
	PRCNT=(ROV-RZRO)/(RRT-RZRO)
	IF(PRCNT.NE.RP)GO TO 19
C  GO BACK AND EXPAND SOME MORE
101	R4=RZRO
	R5=ROV
	R8=RZRO
	R9=RRT-.001
C  JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
	CALL MOVIT(RN,NO,R4,R5,R8,R9)
C  RVX SHOULD BE FARTHEST POINT TO RIGHT.
CCC1200	FORMAT(' MOVED TO STAFF ',F4.0/)
	CALL HYDPOG(3)
2	CALL TYPCRLF
	END